COMMENT ⊗   VALID 00017 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	TITLE IMPTST  IMP
C00005 00003	 Cono Bits . . .  test strin i32 o32 clrst clrwt strout fino iepien idpien odpien test imperr idone iend odone
C00008 00004	 Accumulators.  blok,lostab,ipdl,opdl,mpdl,datatab,detab,omode,imode,nxtlos,lstlos,nloses,idsp,ipdp,nfs,linkn,icnt,datptr,successes,sttcnt,x,nbadl,deptr,deopt,nerr  t t1 t2 t3 t4 t5 p opln ipln mpln maxlnk
C00009 00005	 Here is the SPW code . . .  spw donops noplp tryagn wloop
C00011 00006	 Here is the code that sends the message to ourselves  patch go gosize hdrlup rloop newfrm dhost dimp iplink ipver iphlen ttl protcl arpant srcadr srcad0 srcad1 dstad0 dstad1 hstimp maxdat xbits tlen iden ck0 ck1 inidat meslen skpldr ip1822 datbeg L1822 pdatbg pmesln ptlen pid in1822 pfrmt pmsgty pfhost pip pidin ninmsg
C00022 00007	 Routine to wait for a bit  wait dsm wdsp wdsp1 ist notus ignore clw se ocheck cpopj
C00024 00008	 Here we decode the incoming message  first colect colec2 colec4 colec3 gotip chkmsg wrong1 badmsg goterr stpacs msgerr impwnr nonipe badseq nonfrm short lerr stopfl terror optab nmes illmes regular echk mtss
C00031 00009	 Regular message  reg1
C00032 00010	 Words 2-N of regular message  regn plw mtll daterm nwd nwde
C00034 00011	 Other kinds of messages  ewomi ewmi incompt rfnm unbl unbll ddead impgd ltabf blkl stot1
C00036 00012	 And here is the main program . . .  START
C00038 00013	 Here is the main loop  loop perr
C00040 00014	 Operation dispach table  losops lbl plnk docp inctb inc ltf
C00042 00015	 More error messages  date ewo ew lt ilu eb
C00043 00016	 More error messages  pb ill ms ml id hd ub mo
C00044 00017	 Print routines  octpnt decpnt crlf random pow pow1
C00045 ENDMK
C⊗;
TITLE IMPTST ;⊗ IMP

;??   1983  ME,JJW	Modified for IP protocols
;25 Mar 86  JJW		32-bit mode switch

IMP←←400

MODE32←←-1		;0 for 36-bit mode, -1 for 32-bit
IFN MODE32,<PRINTX Compiling for 32-bit mode>
IFE MODE32,<PRINTX Compiling for 36-bit mode>
NOOUT←←-1		;-1 to disable output
; Cono Bits . . . ;⊗ test strin i32 o32 clrst clrwt strout fino iepien idpien odpien test imperr idone iend odone

test←←100000		; Enter test mode (does anal-cranial inversion)
strin←←040000		; Start input, sets stop, clears input end
i32←←020000		; Set input byte size to 32b if IDPIEN set
o32←←010000		; Set output byte size to 32b if ODPIEN set
clrst←←004000		; Clear stop after input bit
clrwt←←002000		; Clear waiting to input bit
strout←←000200		; Start output
fino←←000100		; Finish output (last bit has been sent)
iepien←←000040		; Enable change of input end interrupt channel
IFE MODE32,<
idpien←←000020		; Enable change of input byte size and input done interrupt channel
odpien←←000010		; Enable change of output byte size and output done interrupt channel
>;IFE MODE32
IFN MODE32,<
idpien←←i32!000020	; Enable change of input byte size and input done interrupt channel
odpien←←o32!000010	; Enable change of output byte size and output done interrupt channel
>;IFN MODE32


; Coni bits . . .

test←←100000		; Enter test mode (does anal-cranial inversion)
imperr←←040000		; Imp error
idone←←020000		; Input done
iend←←010000		; Input end.
odone←←004000		; Output done

comment ⊗
"stop" means enable "wait".  "wait" happens after the last bit has come in
(if enabled by "stop") to allow the programmer to change input modes before the
first bit of the next word comes in.
⊗
; Accumulators.  blok,lostab,ipdl,opdl,mpdl,datatab,detab,omode,imode,nxtlos,lstlos,nloses,idsp,ipdp,nfs,linkn,icnt,datptr,successes,sttcnt,x,nbadl,deptr,deopt,nerr ;⊗ t t1 t2 t3 t4 t5 p opln ipln mpln maxlnk

t←1
t1←2
t2←3
t3←4
t4←5
t5←6
p←17

opln←←20
ipln←←20
mpln←←20

array blok[100],lostab[100],ipdl[ipln],opdl[opln],mpdl[mpln],datatab[1000]
array acs[20],detab[100]
integer nxtlnk,omode,imode,nxtlos,lstlos,nloses
integer spwdsp,idsp,ipdp,nfs,linkn,icnt,datptr,successes,sttcnt
integer a,x,nbadl,deptr,deopt,nerrs
maxlnk:	40
; Here is the SPW code . . . ;⊗ spw donops noplp tryagn wloop

spw:
;;	cono 553	; a bad idea on the KL
	jrst @spwdsp

donops:	move p,[iowd opln,opdl]
	setzm nsent#		;nbr of last msg sent
	setzm lstmsg		;nbr of last msg rcvd
	movei t,first
	movem t,idsp
	setom sndnxt		;ready to have output go (again)
IFE NOOUT,<
	cono imp,strout!strin!clrwt!idpien!odpien!iepien
	movei t,5		;number of no-ops to send
noplp:
;;	datao imp,[4B7]	;(short leader format)
	datao imp,[byte (4)0,17 (16)0 (8)4] ;msg type 4 is a no-op
	pushj p,wait
	datao imp,[0]		;2nd word of no-op
	pushj p,wait
	datao imp,[0]		;3rd word of no-op
	pushj p,wait
	cono imp,fino		;end of msg
	pushj p,wait
;;	sojle t,tryagn
	sojle t,go
	cono imp,strout
	jrst noplp
>;IFE NOOUT
IFN NOOUT,<
	cono imp,strin!clrwt!idpien!iepien
	jrst go
>;IFN NOOUT

repeat 0,<	;no links to be blocked now.
tryagn:	move t,[13B15]
	aos t1,nxtlnk
	caml t1,maxlnk
	setz t1,
	movem t1,nxtlnk
	aosn blok(t1)
	jrst go
	movei t2,3*=60
wloop:	cono imp,strout
	datao imp,[4B7]
	pushj p,wait
	cono imp,fino
	pushj p,wait
	aosn blok(t1)
	jrst go
	sojg t2,wloop
	setom blok(t1)
	hrli t1,ltime
	pushj p,stot1
	jrst tryagn
>;repeat 0
; Here is the code that sends the message to ourselves ;⊗ patch go gosize hdrlup rloop newfrm dhost dimp iplink ipver iphlen ttl protcl arpant srcadr srcad0 srcad1 dstad0 dstad1 hstimp maxdat xbits tlen iden ck0 ck1 inidat meslen skpldr ip1822 datbeg L1822 pdatbg pmesln ptlen pid in1822 pfrmt pmsgty pfhost pip pidin ninmsg

patch:	block 40

go:
IFE NOOUT,<
	pushj p,random		;pick random size for message data
	movem t,savran#		;for debugging, see what the random number is lately
	rot t,-17		;pick up bits in middle of the number
gosize:	andi t,maxdat-1		;limit it to reasonable amt (patch as desired)
IFE MODE32,<
	tro t,1			;force it to be odd to get whole nbr of 8-bit bytes
>;IFE MODE32
IFN MODE32,<
	addi t,1		;force it non-zero
>;IFN MODE32
;t now is the number of 32-bit or 36-bit words of random data to be made
	movem t,msgsiz#		;remember for input check
	outchr ["."]		;Indicate starting a message
;movei t2,15(t)
;outchr t2	;let us see some size variance, if there is any
	dpb t,pdatbg		;store low order bits of size in first byte
	movei t2,(t)		;amt of random data to generate in loop
IFE MODE32,<
	imuli t,=36		;number of bits of random data
>;IFE MODE32
IFN MODE32,<
	imuli t,=32		;number of bits of random data
>;IFN MODE32
	addi t,xbits+iphlen*=32	;add in IP hdr bits plus left over bits
	dpb t,pmesln		;store in hst/IMP leader
	lsh t,-3		;convert to number of octets in IP msg, incl hdr
	dpb t,ptlen		;store in IP hdr
	aos t,nsent#		;count another message being sent
	dpb t,pid		;store in ID field of message

	movei t1,ip1822		;address to start outputting from
	hrli t1,-(datbeg+1-ip1822) ;nbr of words of leader/hdr to output
	cono imp,strout!odpien	;tell interface we're starting a new msg
hdrlup:	datao imp,(t1)		;output a word to the IMP
	pushj p,wait		;wait till it's ready for next word
	aobjn t1,hdrlup		;loop till done all hdr words

	movei t1,datbeg+1	;place to store random data
repeat 0,<
	dpb t1,[point 8,t,23]
	cono imp,strout!odpien
	datao imp,t
	pushj p,wait
	pushj p,random
	and t,[xwd 400007,0]
	tlnn t,7
	tlo t,1
	datao imp,t
	movem t,omode
	pushj p,wait
	skipge t
	cono imp,o32!odpien
	ldb t2,[point 3,t,17]
	lsh t1,3
	addi t1,datatab
>;repeat 0
rloop:	pushj p,random		;make random number
;	skipg omode		;skip if 36-bit mode
;	andcmi t,17		;32-bit mode, clear low order bits
IFN MODE32,<
	andcmi t,17		;32-bit mode, clear low order bits
>;IFN MODE32
	movem t,(t1)		;store for later comparison test
	datao imp,t		;give data to the imp
	pushj p,wait		;wait for next interrupt
	addi t1,1		;advance data block pointer
	sojg t2,rloop		;loop until sent enough data
	cono imp,fino		;say end of msg
;now wait till we've read that msg before sending another
	setzm sndnxt		;sent another msg now, wait for it to be read
;;	jrst tryagn		;send another test msg
>;IFE NOOUT
	pushj p,wait		;wait till msg read and checked
	jrst go			;send another test msg

newfrm←←17	;new format leader
dhost←←0	;host (within IMP) to send to (us)
dimp←←13	;IMP to send to (us)
iplink←←233	;link field value indicating IP
ipver←←4	;IP version nbr
iphlen←←5	;IP hdr length  (in 32 bit words)
ttl←←30		;time to live, in seconds
protcl←←21	;sub-protocol (UDP, for fun)
arpant←←=10	;network nbr of ARPAnet
srcadr←←dstadr←←<byte (4)0 (8)arpant,dhost (16)dimp> ;source and dest IP addresses
IFE MODE32,<
srcad0←←srcadr⊗-8 ;high 24 bits of src addr
srcad1←←srcadr&377 ;low 8 bits of src addr
dstad0←←dstadr⊗-4 ;high 28 bits of src addr
dstad1←←dstadr&17 ;low 4 bits of src addr
>;IFE MODE32
hstimp←←<byte (12)0 (8)dhost (16)dimp> ;our host/imp nbr

maxdat←←20	;max amt of data we want to send in this test, must be power of 2
xbits←←=32	;number of random bits in last 36-bit word for IP hdr

tlen←←0		;total length of IP datagram in 8-bit bytes (octets)
iden←←0		;identification, for fragment reassembly
IFN MODE32,<
ckip←←0		;IP header checksum
>;IFN MODE32
IFE MODE32,<
ck0←←0		;first part of IP header checksum
ck1←←0		;second part of IP header checksum
>;IFE MODE32
inidat←←0	;initial byte of random data
meslen←←0	;msg length in bits (from IP hdr on)

;skpldr←←2	;nbr of leader words different on input and output
skpldr←←0	;nbr of leader words different on input and output

IFE MODE32,<
;host/IMP header and IP hdr.
;a byte size starting with 0 indicates the beginning of a new 32-bit word.
ip1822:	byte (04)0,newfrm (8)0,0,0 (04)0		;message type 0
	byte (4)0 (8)dhost (16) dimp (08)iplink
	byte (4)0,0 (16)meslen (04)ipver,iphlen,0	;IP hdr starts here
	byte (4)0 (16)tlen (016)iden
	byte (3)0 (13)0 (08)ttl,protcl (4)ck0
	byte (12)ck1 (024)srcad0
	byte (8)srcad1 (028)dstad0
datbeg:	byte (4)dstadr (032)inidat			;IP hdr ends here
	block 1000		;allow for patching of GOSIZE
	block maxdat		;block for random data to get stuffed in
L1822←←.-ip1822

pdatbg:	point xbits,datbeg,35	;first data byte to be filled in at random
pmesln:	point 16,ip1822+2,23	;msg length in bits, from IP hdr on
ptlen:	point 16,ip1822+3,19	;IP datagram length in octets, incl IP hdr
pid:	point 16,ip1822+3,35	;ID field for fragment assembly (and debugging)

in1822:	block L1822		;block for input data

pfrmt:	point 4,in1822,7	;new format flag goes here
pmsgty:	point 8,in1822,31	;msg type field
pfhost:	point 24,in1822+1,27	;source host/imp
pip:	point 8,in1822+1,35	;link field for checking type as IP
pidin:	point 16,in1822+3,35	;ID field for fragment assembly (and debugging)
>;IFE MODE32

IFN MODE32,<
;Host/IMP header and IP hdr.  Simpler in 32-bit mode.
ip1822:	byte (4)0,newfrm (8)0,0,0		;message type 0
	byte (8)0,dhost (16)dimp
	byte (8)iplink,0 (16)meslen
	byte (4)ipver,iphlen (8)0 (16)tlen	;IP hdr starts here
	byte (16)iden,0
	byte (8)ttl,protcl (16)ckip
	byte (32)srcadr
	byte (32)dstadr				;IP hdr ends here
datbeg:	byte (32)inidat
	block 1000		;allow for patching of GOSIZE
	block maxdat		;block for random data to get stuffed in
L1822←←.-ip1822

pdatbg:	point xbits,datbeg,31	;first data byte to be filled in at random
pmesln:	point 16,ip1822+2,31	;msg length in bits, from IP hdr on
ptlen:	point 16,ip1822+3,31	;IP datagram length in octets, incl IP hdr
pid:	point 16,ip1822+4,15	;ID field for fragment assembly (and debugging)

in1822:	block L1822		;block for input data

pfrmt:	point 4,in1822,7	;new format flag goes here
pmsgty:	point 8,in1822,31	;msg type field
pfhost:	point 24,in1822+1,31	;source host/imp
pip:	point 8,in1822+2,7	;link field for checking type as IP
pidin:	point 16,in1822+4,15	;ID field for fragment assembly (and debugging)
>;IFN MODE32

ninmsg:	block 400		;counts of input msgs for all possible msg types
; Routine to wait for a bit ;⊗ wait dsm wdsp wdsp1 ist notus ignore clw se ocheck cpopj

wait:	movem 17,acs+17
	movei 17,acs
	blt 17,acs+16
	movei t,wdsp
	movem t,spwdsp
	conso imp,idone!iend
dsm:	call [sixbit /DISMIS/]
	jrst ist

wdsp:	conso imp,imperr
	jrst wdsp1
	movei t5,impwnr		;imp went not ready
	jrst goterr		;maybe stop on error
;	movsi t1,eb
;	move p,ipdp
;	pushj p,stot1
wdsp1:	conso imp,idone!iend
	jrst ocheck
ist:	coni imp,t
	datai imp,t1
	move p,ipdp
	jrst @idsp

notus:	aos nfs
ignore:	trne t,iend
	jrst se
	cono imp,clrst!clrwt
	movei t,ignore
	movem t,idsp
	jrst ocheck

clw:	cono imp,clrwt
	jrst ocheck

sego:	setom sndnxt		;ready to have output go again
se:	cono imp,strin!clrwt!idpien!iepien
	movei t,first
	movem t,idsp
ocheck:	skipe sndnxt		;skip if not ready to output more
	conso imp,odone
	jrst dsm
	movsi 17,acs
	blt 17,17
cpopj:	popj p,
; Here we decode the incoming message ;⊗ first colect colec2 colec4 colec3 gotip chkmsg wrong1 badmsg goterr stpacs msgerr impwnr nonipe badseq nonfrm short lerr stopfl terror optab nmes illmes regular echk mtss

;here with first word of message in t1, coni bits in t.
first:	movei t2,in1822		;set up addr to store msg
	movem t2,pi1822#	;remember how far we've gotten
	movem t1,(t2)		;store first leader word
	setzm in1822+1		;clear input buffer
	move t3,[in1822+1,,in1822+2]
	blt t3,in1822+l1822-1	;clear rest of input block
	movei t3,colect		;set up dispatch to collect whole message
	movem t3,idsp
	jrst colec2

colect:	aos t2,pi1822		;address for next input word
	caige t2,in1822+l1822	;don't overflow buffer
	movem t1,(t2)		;store latest word
colec2:	trnn t,iend		;end of msg?
	jrst clw		;no
;here with whole msg in block at in1822.  see what we have.
	movem t2,lastt2#	;store ptr to last word of packet
	cail t2,in1822+2	;is packet at least 96 bits (3 words)?
	jrst colec4		;yes
	movei t5,short
	jrst goterr		;no, this is an error
colec4:	ldb t3,pfrmt		;get new format flag
	cain t3,newfrm		;better be new format
	jrst colec3		;yup
	movei t5,nonfrm		;nope
	jrst goterr		;not a new format leader (probably IMP just came up)

colec3:	ldb t3,pmsgty
	aos ninmsg(t3)		;count an input msg of this type
	jumpn t3,se		;ignore all but regular msgs (type 0)
	ldb t3,pip		;see if this is an IP msg
	cain t3,iplink		;skip if not IP
	jrst gotip		;IP msg
	aos t3,nonip#		;count non IP msgs
	movei t5,nonipe		;error code
	jrst goterr		;maybe stop and let someone look

gotip:	ldb t3,pfhost		;get source host/imp
	came t3,[hstimp]	;is it from us?
	jrst se			;no, just ignore it
	ldb t3,pidin		;get message nbr
	aos lstmsg		;count another msg rcvd
	camn t3,lstmsg#		;should be one more than prev msg rcvd
	came t3,nsent#		;should be one we sent last
	jrst wrong1		;but it isn't
	movn t3,msgsiz#		;make aobjn ptr for comparing input with output
	subi t3,datbeg+1-ip1822-skpldr ;initial hdr words to check
	movsi t3,(t3)		;aobjn count in LH
	hrri t3,skpldr		;initial offset in RH
chkmsg:	move t4,ip1822(t3)	;get what we sent
	came t4,in1822(t3)	;skip if that's what we received
	jrst badmsg		;error detected
	aobjn t3,chkmsg		;loop through whole msg
	aos successes		;count a success
	jrst sego		;re-init input dispatch for new msg

;we sometimes get the same msg twice in a row, or maybe we get them out
;of order?
wrong1:	movei t5,badseq		;msg out of sequence
	jrst goterr

badmsg:	movei t5,msgerr		;message in error
goterr:	movem t5,lsterr#	;remember which type of error was most recent
	outchr ["?"]		;Indicate error
	aos nerrs		;count total errors
	aos terror(t5)		;count errors of this type
IFE NOOUT,<
	skiple nsent		;skip if no msgs sent yet, ignore startup problem
>;IFE NOOUT
	skipn stopfl(t5)	;want to stop on that type of error?
	jrst donops		;no, go start over with no-ops
	setom stperr#		;indicate stopping on error, for main routine
	movem 17,stpacs+17	;save all ACs for poking
	movei 17,stpacs
	blt 17,stpacs+16
	spcwar 'ssw'		;stop spacewar
	jrst dsm		;dismis

stpacs:	block 20	;ACs at time of error stop

msgerr←←0	;data comparison failure
impwnr←←1	;IMP went not ready
nonipe←←2	;non IP msg
badseq←←3	;bad seq of msgs rcvd
nonfrm←←4	;not a new format leader
short←←5	;packet less than 96 bits
lerr←←6	;nbr of error types

stopfl:	repeat lerr,<-1>	;default is to stop on all errors
terror:	block lerr		;count errors of each type here

repeat 0,<
	ldb t3,[point 8,t1,23]		; Link # in T3
	caml t3,maxlnk
	caie t3,233			;IP?
	jrst [	aos nbadl		;no
		jrst ignore]
	ldb t4,[point 4,t1,7]
	ldb t5,[point 8,t1,15]
	cail t4,nmes
	jrst illmes
	jrst @optab(t4)

optab:	regular
	ewomi
	impgd
	blkl
	ignore
	rfnm
	ltabf
	ddead
	ewmi
	incompt
nmes←←.-optab

illmes:	movsi t1,illop
	pushj p,stot1
	jrst ignore

regular:
	caie t5,13
	jrst ignore		; Not from us, forget it
	movei t1,reg1
	movem t1,idsp
	movem t3,linkn
	skipl blok(t3)
	jrst echk
	movsi t1,moubl
	ori t1,(t3)
	pushj p,stot1
	jrst ignore

echk:	trnn t,iend
	jrst clw
mtss:	movsi t1,mts
	pushj p,stot1
	jrst ignore
; Regular message ;⊗ reg1

reg1:	trne t,iend
	jrst mtss
	skipge t1
	cono imp,i32!iepien!idpien
	movem t1,imode
	cono imp,clrst!clrwt
	ldb t2,[point 3,t1,17]
	movem t2,icnt
	move t3,linkn
	lsh t3,3
	addi t3,datatab
	movem t3,datptr
	movei t1,regn
	movem t1,idsp
	jrst ocheck
; Words 2-N of regular message ;⊗ regn plw mtll daterm nwd nwde

regn:	sos t3,icnt
	jumpg t3,nwd
	jumpl t3,plw
	skipg imode
	ori t1,10
	jrst nwd

plw:	skipg imode
	jrst mtll
	came t1,[xwd 400000,0]
	jrst daterm
	trne t,iend
	jrst [	aos successes
		jrst se]
mtll:	movsi t1,mtl
	pushj p,stot1
	jrst ignore

daterm:	movsi t1,pberr
	or t1,linkn
	pushj p,stot1
	jrst ignore

nwd:	came t1,@datptr
	jrst nwde
	aos datptr
	jrst ocheck

nwde:	move t2,deptr
	addi t2,2
	cail t2,detab+100
	movei t2,detab
	movem t2,deptr
	movem t1,(t2)
	move t1,@datptr
	movem t1,1(t2)
	movsi t1,daterr
	or t1,linkn
	pushj p,stot1
	jrst ignore
; Other kinds of messages ;⊗ ewomi ewmi incompt rfnm unbl unbll ddead impgd ltabf blkl stot1

ewomi:	movsi t1,ewom
	pushj p,stot1
	jrst ignore

ewmi:	skipa t1,[xwd ewm,0]
incompt:
	movsi t1,incom
	ori t1,(t3)
	pushj p,stot1
rfnm:	cain t5,13
	jrst unbl
	movsi t1,illunb
	ori t1,(t5)
	pushj p,stot1
unbl:	skipl blok(t3)
	jrst unbll
	movsi t1,unbbl
	ori t1,(t3)
	pushj p,stot1
unbll:	setom blok(t3)
	jrst ignore

ddead:	skipa t1,[xwd hdead,0]
impgd:	movsi t1,impd
	pushj p,stot1
	jrst ignore

ltabf:	skipa t1,[xwd ltabfl,0]
blkl:	movsi t1,lblock
	ori t1,(t3)
	pushj p,stot1
	jrst ignore

stot1:	aos t2,nxtlos
	aos nloses
	cail t2,lostab+100
	movei t2,lostab
	movem t2,nxtlos
	movem t1,(t2)
	popj p,
>;repeat 0
; And here is the main program . . . ;⊗ START

START:	move p,[iowd mpln,mpdl]
	calli
	movei t,first
	movem t,idsp
	setzm stperr		;not stopped on error yet
	setom sndnxt#		;ready to have output go
	call t,[sixbit /TIMER/]
	call t1,[sixbit /DATE/]
	rot t,12
	xor t,t1
	andcm t,[1B0+3]
	addi t,1
	movem t,a
	call t1,[sixbit /MSTIME/]
	xor t,t1
	movem t,x
	setom blok
	move t,[xwd blok,blok+1]
	blt t,blok+77
	movei t,lostab
	movem t,nxtlos
	movem t,lstlos
	movei t,detab
	movem t,deptr
	movem t,deopt
	setzm nloses
	setzm nerrs
	setzm nbadl
	setzm nfs
	setzm successes
	setzm nxtlnk
	movei t,donops
	movem t,spwdsp
	move t,[iowd ipln,ipdl]
	movem t,ipdp
	movei t,=10
	movem t,sttcnt
	move 1,[xwd 400001,spw]
	call 1,[sixbit /SPCWGO/]
; Here is the main loop ;⊗ loop perr

loop:	skipn stperr		;did SPW stop on an error?
	jrst loop1		;no
	outstr [asciz/
Error detected.../]
	movei t,cpopj
	movem t,jobopc↑		;let ddt be able to continue
	skipe jobddt
	pushj p,@jobddt↑	;call ddt/raid
	jrst start		;start over

loop1:	movei t,1
	call t,[sixbit /SLEEP/]
	sosle sttcnt
	jrst perr
	movei t,=60
	movem t,sttcnt
	outstr [asciz /
/]
	move t,successes
	pushj p,decpnt
	outstr [asciz / successful transfers
/]
	move t,nerrs
	pushj p,decpnt
	outstr [asciz / errors
/]
perr:	skipn nloses
	jrst loop
	aos nerrs
	sos nloses
	hlrz t,@lstlos
	jrst @losops(t)
; Operation dispach table ;⊗ losops lbl plnk docp inctb inc ltf

losops:	lbl ↔ lblock←←0
	inc ↔ incom←←1
	ltf ↔ ltabfl←←2
	date ↔ daterr←←3
	ewo ↔ ewom←←4
	ew ↔ ewm←←5
	ill ↔ illop←←6
	ms ↔ mts←←7
	ml ↔ mtl←←10
	id ↔ impd←←11
	hd ↔ hdead←←12
	lt ↔ ltime←←13
	ilu ↔ illunb←←14
	pb ↔ pberr←←15
	ub ↔ unbbl←←16
	mo ↔ moubl←←17
	eb ↔ errb←←20

lbl:	outstr [asciz /Blocked link /]
plnk:	hrrz t,@lstlos
	pushj p,octpnt
docp:	pushj p,crlf
inctb:	aos t,lstlos
	cail t,lostab+100
	movei t,lostab
	movem t,lstlos
	jrst perr

inc:	outstr [asciz /Incomplete transmission /]
	jrst plnk

ltf:	outstr [asciz /Link table full
/]
	jrst inctb
; More error messages ;⊗ date ewo ew lt ilu eb

date:	outstr [asciz /Data error /]
	hrrz t,@lstlos
	pushj p,octpnt
	pushj p,crlf
	move t4,deopt
	addi t4,2
	cail t4,detab+100
	movei t4,detab
	movem t4,deopt
	move t,(t4)
	pushj p,pow
	outstr [asciz /   /]
	move t,1(t4)
	pushj p,pow
	jrst docp

ewo:	outstr [asciz /Error without message identification
/]
	jrst inctb

ew:	outstr [asciz /Error with message identification /]
	jrst plnk

lt:	outstr [asciz /Link timed out /]
	jrst plnk

ilu:	outstr [asciz /Unblocking link of strange host /]
	jrst plnk

eb:	outstr [asciz /Error bit came up
/]
	jrst inctb
; More error messages ;⊗ pb ill ms ml id hd ub mo

pb:	outstr [asciz /Padding bit error /]
	jrst plnk

ill:	outstr [asciz /Illegal opcode
/]
	jrst inctb

ms:	outstr [asciz /Message too short
/]
	jrst inctb

ml:	outstr [asciz /Message too long
/]
	jrst inctb

id:	outstr [asciz /Imp going down
/]
	jrst inctb

hd:	outstr [asciz /Host dead???
/]
	jrst inctb

ub:	outstr [asciz /Attempt to unblock an already unblocked link /]
	jrst plnk

mo:	outstr [asciz /Message on unblocked link /]
	jrst plnk
; Print routines ;⊗ octpnt decpnt crlf random pow pow1

octpnt:	idivi t,10
	hrlm t+1,(p)
	skipe t
	pushj p,octpnt
	hlrz t,(p)
	addi t,"0"
	outchr t
	popj p,

decpnt:	idivi t,=10
	hrlm t+1,(p)
	skipe t
	pushj p,decpnt
	hlrz t,(p)
	addi t,"0"
	outchr t
	popj p,

crlf:	outstr [asciz /
/]
	popj p,

random:	move t,x
	imul t,a
	add t,[=1824726041]
;;	andcm t,[1B0]
	movem t,x
	popj p,

pow:	movei t5,=12
pow1:	setz t+1,
	rotc t,3
	addi t+1,"0"
	outchr t+1
	sojg t5,pow1
	popj p,

end start